home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / archives.swg / 0015_Zip Viewer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-25  |  15.0 KB  |  285 lines
  1. {------8<-------------Snip---------------8<------------Snip------------8<-------}
  2. {$I-}
  3. UNIT zipviewu;
  4.  
  5. (*/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\\/\/\/\/\/\/\/\*)
  6. (* Unit : Zip View                    Date : March 23, 1994                  *)
  7. (* By   : John Shipley                Ver  : 1.0                             *)
  8. (*                                                                           *)
  9. (* Credits : Steve Wierenga - ZIPV.PAS found in SWAG - Got me started on the *)
  10. (*           zipviewu code since ZIPV.PAS was fairly easy to read unlike     *)
  11. (*           some other code I had seen.                                     *)
  12. (*                                                                           *)
  13. (*           Tom Guinther - ZIPPER.PAS found in ZIPPER.ZIP (1989) available  *)
  14. (*           on my BBS "The Brook Forest Inn 714-951-5282" This code helped  *)
  15. (*           clarify many things. The zipper code is probably better than    *)
  16. (*           this code and well documented.                                  *)
  17. (*                                                                           *)
  18. (*           PkWare's APPNOTE.TXT found in PKZ110.EXE                        *)
  19. (*                                                                           *)
  20. (* This unit is offered to the Public Domain so long as credit is given      *)
  21. (* where credit is due. I accept NO liablity for what this code does to your *)
  22. (* system or your friends or anyone elses. You have the code, so you can fix *)
  23. (* it. If this code formats your hard drive and you loose your lifes work,   *)
  24. (* then all I can say is "Why didn't you back it up?"                        *)
  25. (*                                                                           *)
  26. (* Purpose: To mimic "PKUNZIP -v <filename>" output. (v2.04g)                *)
  27. (*          The code is pretty close to the purpose, but not perfect.        *)
  28. (*                                                                           *)
  29. (* Demo :                                                                    *)
  30. (*                                                                           *)
  31. (* PROGRAM zip_viewit;                                                       *)
  32. (* USES DOS,CRT,zipviewu;                                                    *)
  33. (* BEGIN                                                                     *)
  34. (*   IF PARAMCOUNT<>0 THEN                                                   *)
  35. (*     BEGIN                                                                 *)
  36. (*       zipview(PARAMSTR(1));                                               *)
  37. (*     END;                                                                  *)
  38. (* END.                                                                      *)
  39. (*/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\\/\/\/\/\/\/\/\*)
  40.  
  41. INTERFACE
  42.  
  43. USES DOS,CRT;
  44.  
  45. PROCEDURE zipview(zipfile: STRING);
  46.  
  47. IMPLEMENTATION
  48.  
  49. CONST hexdigit : ARRAY[0..15] OF CHAR = '0123456789abcdef';
  50.  
  51. FUNCTION hexbyte(b: byte): STRING;                        (* Byte to Hexbyte *)
  52.   BEGIN
  53.     hexbyte := hexdigit[b SHR 4]+hexdigit[b AND $f];
  54.   END;
  55.  
  56. FUNCTION hexlong(l: LONGINT): STRING;                  (* Longint to Hexlong *)
  57.   VAR n : ARRAY[1..4] OF BYTE ABSOLUTE l;
  58.   BEGIN
  59.     hexlong := hexbyte(n[4])+hexbyte(n[3])+hexbyte(n[2])+hexbyte(n[1]);
  60.   END;
  61.  
  62. FUNCTION lenn(s: STRING): INTEGER;     (* Like LENGTH, but skips color codes *)
  63.   VAR i,len : INTEGER;
  64.   BEGIN
  65.     len := LENGTH(s);
  66.     i := 1;
  67.     WHILE (i<=LENGTH(s)) DO
  68.       BEGIN
  69.         IF (s[i] IN [#3,'^']) THEN
  70.           IF (i<LENGTH(s)) THEN
  71.             BEGIN
  72.               DEC(len,2);
  73.               INC(i);
  74.             END;
  75.         INC(i);
  76.       END;
  77.     lenn := len;
  78.   END;
  79.  
  80. FUNCTION mln(s: STRING; l: INTEGER): STRING;                 (* Left Justify *)
  81.   BEGIN
  82.     WHILE (lenn(s)<l) DO s := s+' ';
  83.     IF (lenn(s)>l) THEN
  84.       REPEAT
  85.         s := COPY(s,1,LENGTH(s)-1)
  86.       UNTIL (lenn(s)=l) OR (LENGTH(s)=0);
  87.     mln := s;
  88.   END;
  89.  
  90. FUNCTION mrn(s: STRING; l: INTEGER): STRING;                (* Right Justify *)
  91.   BEGIN
  92.     WHILE lenn(s)<l DO s := ' '+s;
  93.     IF lenn(s)>l THEN s := COPY(s,1,l);
  94.     mrn := s;
  95.   END;
  96.  
  97. FUNCTION cstr(i: LONGINT): STRING;         (* convert integer type to string *)
  98.   VAR c : STRING[16];
  99.   BEGIN
  100.     STR(i,c);
  101.     cstr := c;
  102.   END;
  103.  
  104. FUNCTION tch(s: STRING): STRING;                          (* Ensure 2 Digits *)
  105.   BEGIN
  106.     IF (LENGTH(s)>2) THEN s := COPY(s,LENGTH(s)-1,2)
  107.     ELSE IF (LENGTH(s)=1) THEN s := '0'+s;
  108.     tch := s;
  109.   END;
  110.  
  111. FUNCTION b2attr(a,g: BYTE): STRING;                     (* Byte to Attribute *)
  112.   VAR attr : STRING[5];
  113.   BEGIN
  114.     attr := '--w- ';
  115.     IF (g AND 1)=1 THEN attr[5]:='*';                          (* Encrypted? *)
  116.     IF (a AND 1)=1 THEN attr[3]:='r';                          (* Read Only? *)
  117.     IF (a AND 2)=2 THEN attr[2]:='h';                             (* Hidden? *)
  118.     IF (a AND 4)=4 THEN attr[1]:='s';                             (* System? *)
  119.     IF (a AND 8)=8 THEN attr[4]:='?';                (* Unknown at this time *)
  120.     b2attr := attr;
  121.   END;
  122.  
  123. FUNCTION w2date(d: WORD): STRING;                            (* Word to Date *)
  124.   VAR s : STRING;
  125.   BEGIN
  126.     s := tch(cstr((d SHR 5) AND 15 ))+'-'+                          (* Month *)
  127.          tch(cstr((d      ) AND 31 ))+'-'+                            (* Day *)
  128.          tch(cstr(((d SHR 9) AND 127)+80));                          (* Year *)
  129.     w2date := s;
  130.   END;
  131.  
  132. FUNCTION w2time(t: WORD): STRING;                            (* Word to Time *)
  133.   VAR s : STRING;
  134.   BEGIN
  135.     s := tch(cstr((t SHR 11) AND 31))+':'+                           (* Hour *)
  136.          tch(cstr((t SHR  5) AND 63));                             (* Minute *)
  137.     w2time := s;
  138.   END;
  139.  
  140. PROCEDURE zipview(zipfile: STRING);                     (* View the ZIP File *)
  141.   CONST lsig = $04034B50;                                 (* Local Signature *)
  142.         csig = $02014b50;                               (* Central Signature *)
  143.   TYPE lheader = RECORD                                      (* Local Header *)
  144.                    signature  : LONGINT;      (* local file header signature *)
  145.                    version,                                (* version mad by *)
  146.                    gpflag,                          (* general purpose flags *)
  147.                    compress,                           (* compression method *)
  148.                    time,date  : WORD;         (* last mod file time and date *)
  149.                    crc32,                                          (* crc-32 *)
  150.                    csize,                                 (* compressed size *)
  151.                    usize      : LONGINT;                (* uncompressed size *)
  152.                    fnamelen,                              (* filename length *)
  153.                    extrafield : WORD;                  (* extra field length *)
  154.                  END;
  155.        cheader = RECORD                                    (* Central Header *)
  156.                    signature  : LONGINT;    (* central file header signature *)
  157.                    version    : WORD;                     (* version made by *)
  158.                    vneeded    : WORD;           (* version needed to extract *)
  159.                    gpflag     : ARRAY[1..2] OF BYTE;(* general purpose flags *)
  160.                    compress   : WORD;                  (* compression method *)
  161.                    time       : WORD;                  (* last mod file time *)
  162.                    date       : WORD;                  (* last mod file date *)
  163.                    crc32      : LONGINT;                           (* crc-32 *)
  164.                    csize      : LONGINT;                  (* compressed size *)
  165.                    usize      : LONGINT;                (* uncompressed size *)
  166.                    fnamelen   : WORD;                     (* filename length *)
  167.                    extrafield : WORD;                  (* extra field length *)
  168.                    fcl        : WORD;                 (* file comment length *)
  169.                    dns        : WORD;                   (* disk number start *)
  170.                    ifa        : WORD;            (* internal file attributes *)
  171.                    efa        : ARRAY[1..4] OF BYTE;   (* external file attr *)
  172.                    roolh      : LONGINT;  (* relative offset of local header *)
  173.                  END;
  174.  
  175. VAR z          : INTEGER;               (* Number of files processed counter *)
  176.     totalu,                              (* Total bytes that were compressed *)
  177.     totalc     : LONGINT;          (* result of total bytes being compressed *)
  178.     hdr        : ^cheader;            (* temporary cental header file record *)
  179.     f          : FILE;                                           (* file var *)
  180.     s          : STRING;                          (* archive filename string *)
  181.     percent    : BYTE;           (* Temporary var holding percent compressed *)
  182.     numfiles   : WORD;                         (* Number of files in archive *)
  183.  
  184. CONST comptypes : ARRAY[0..8] OF STRING[7] =            (* Compression Types *)
  185.                   ('Stored ',                              (* Not Compressed *)
  186.                    'Shrunk ',                                      (* Shrunk *)
  187.                    'Reduce1',                                   (* Reduced 1 *)
  188.                    'Reduce2',                                   (* Reduced 2 *)
  189.                    'Reduce3',                                   (* Reduced 3 *)
  190.                    'Reduce4',                                   (* Reduced 4 *)
  191.                    'Implode',                                    (* Imploded *)
  192.                    'NotSure',                        (* Unknown at this time *)
  193.                    'DeflatN');                                   (* Deflated *)
  194.  
  195. FUNCTION seekc(VAR f: FILE): BOOLEAN;
  196.   VAR curpos  : LONGINT;                           (* current file position *)
  197.       buf     : lheader;                   (* Temporary local header record *)
  198.       ioerror : INTEGER;                       (* Temporary IOResult holder *)
  199.       result  : WORD;                                   (* Blockread Result *)
  200.   BEGIN
  201.     seekc := FALSE;                                           (* init seekc *)
  202.     curpos := 0;                              (* init current file position *)
  203.     SEEK(f,0);                                        (* goto start of file *)
  204.     BLOCKREAD(f,buf,SIZEOF(lheader),result);     (* Grab first local header *)
  205.     ioerror := IORESULT;                                  (* Test for error *)
  206.     WHILE (ioerror = 0) AND (buf.signature=lsig) DO (* Test if OK..continue *)
  207.       BEGIN
  208.         INC(numfiles);                         (* Increment number of files *)
  209.         WITH buf DO                             (* Find end of local header *)
  210.           curpos := FILEPOS(f)+fnamelen+extrafield+csize;
  211.         SEEK(f,curpos);                         (* Goto end of local header *)
  212.         BLOCKREAD(f,buf,SIZEOF(lheader),result);  (* Grab next local header *)
  213.         ioerror := IORESULT;                              (* Test for error *)
  214.       END;
  215.       IF ioerror<>0 THEN EXIT;               (* If error then exit function *)
  216.       IF (buf.signature=csig) THEN (* Did we find the first central header? *)
  217.         BEGIN
  218.           seekc := TRUE;                      (* Found first central header *)
  219.           SEEK(f,curpos); (* Ensure we are at central headers file position *)
  220.         END;
  221.   END;
  222.  
  223.   VAR curpos : LONGINT;
  224.  
  225.   BEGIN
  226.     numfiles := 0;      (* Counter of Number of Files to Determine When Done *)
  227.     z        := 0;                   (* Counter of Number of Files Processed *)
  228.     totalu   := 0;                      (* Total Bytes of Uncompressed Files *)
  229.     totalc   := 0;                      (* Total Size after being Compressed *)
  230.     NEW(hdr);        (* Dynamically Allocate Memory for a Temp Header Record *)
  231.     ASSIGN(f,zipfile);                        (* Assign Filename to File Var *)
  232.     {$I-}
  233.     RESET(f,1);                                         (* Open Untyped File *)
  234.     {$I+}
  235.     IF IORESULT<>0 THEN                  (* If we get an error, exit program *)
  236.       BEGIN
  237.         WRITELN('Error - File not found.');
  238.         HALT(253);
  239.       END;
  240.     IF NOT seekc(f) THEN (* Skip Local Headers and goto first Central Header *)
  241.       BEGIN                       (* If we could not locate a Central Header *)
  242.         CLOSE(f);                                      (* Close Untyped File *)
  243.         WRITELN('Error - Corrupted or Not a ZIP File.');
  244.         HALT(254);                                           (* Exit Program *)
  245.       END;
  246.  
  247.     WRITELN(' Length  Method   Size  Ratio   Date    Time    CRC-32 '+
  248.       ' Attr  Name');
  249.     WRITELN(' ------  ------   ----- -----   ----    ----   --------'+
  250.       ' ----  ----');
  251.     REPEAT
  252.       FILLCHAR(s,SIZEOF(s),#0);                         (* Clear Name String *)
  253.       BLOCKREAD(f,hdr^,SIZEOF(cheader));                 (* Read File Header *)
  254.       BLOCKREAD(f,MEM[SEG(s):OFS(s)+1],hdr^.fnamelen);  (* Read Archive Name *)
  255.       s[0] := CHR(hdr^.fnamelen);                 (* Get Archive Name Length *)
  256.       IF (hdr^.signature=csig) THEN                           (* Is a header *)
  257.         BEGIN
  258.           INC(z);                                  (* Increment File Counter *)
  259.           WRITE(mrn(cstr(hdr^.usize),7));       (* Display Uncompressed Size *)
  260.           WRITE(' '+mrn(comptypes[hdr^.compress],7));  (* Compression Method *)
  261.           WRITE(mrn(cstr(hdr^.csize),8));         (* Display Compressed Size *)
  262.           percent := ROUND(100.0-(hdr^.csize/hdr^.usize*100.0));
  263.           WRITE(mrn(cstr(percent),4)+'% ');   (* Display Compression Percent *)
  264.           WRITE(' '+w2date(hdr^.date)+' ');    (* Display Date Last Modified *)
  265.           WRITE(' '+w2time(hdr^.time)+' ');    (* Display Time Last Modified *)
  266.           WRITE(' '+hexlong(hdr^.crc32)+' ');       (* Display CRC-32 in Hex *)
  267.           WRITE(b2attr(hdr^.efa[1],hdr^.gpflag[1]));   (* Display Attributes *)
  268.           WRITELN(' '+mln(s,13));                (* Display Archive Filename *)
  269.           INC(totalu,hdr^.usize);             (* Increment size uncompressed *)
  270.           INC(totalc,hdr^.csize);               (* Increment size compressed *)
  271.         END;
  272.       SEEK(f,FILEPOS(f)+hdr^.extrafield+hdr^.fcl);
  273.     UNTIL (hdr^.signature<>csig) OR EOF(f) OR (z=numfiles); (* No more Files *)
  274.     WRITELN(' ------          ------  ---                                 '+
  275.       ' -------');
  276.     WRITE(mrn(cstr(totalu),7)+'         ');    (* Display Total Uncompressed *)
  277.     WRITE(mrn(cstr(totalc),7)+' ');              (* Display Total Compressed *)
  278.     WRITE((100-TotalC/TotalU*100):3:0,'%'+mrn(' ',34));   (* Display Percent *)
  279.     WRITELN(mrn(cstr(z),7));                      (* Display Number of Files *)
  280.     CLOSE(f);                                          (* Close Untyped File *)
  281.     DISPOSE(hdr);                            (* Deallocate Header Var Memory *)
  282.   END;
  283.  
  284. END.
  285.